home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Disc to the Future 2
/
Disc to the Future Part II Programmer's Reference (Wayzata Technology)(6013)(1992).bin
/
UNIX
/
PASCAL
/
PTOC
/
PTC_P.3
< prev
next >
Wrap
Text File
|
1992-11-23
|
50KB
|
2,502 lines
tx^.tto := ty^.thi
end
else if ty^.tt = nscalar then
begin
ty := ty^.tscalid;
tx^.tfrom := ty;
while ty^.tnext <> nil do
ty := ty^.tnext;
tx^.tto := ty
end
else if ty = typnods[tchar] then
begin
currsym.st := schar;
currsym.vchr := chr(minchar);
tx^.tfrom := mklit;
currsym.st := schar;
currsym.vchr := chr(maxchar);
tx^.tto := mklit
end
else if ty = typnods[tinteger] then
begin
currsym.st := sinteger;
currsym.vint := -maxint;
tx^.tfrom := mklit;
currsym.st := sinteger;
currsym.vint := maxint;
tx^.tto := mklit
end
else
fatal(etree);
tx^.tforstmt := tz;
tx^.tincr := true
end;
npredef,
nfileof:
if opn then
begin
(* create file-struct initialization *)
ty := mknode(nselect);
ty^.trecord := ti;
ty^.tfield :=
oldid(defnams[dzinit]^.lid,
lforward);
tx := mknode(nassign);
tx^.tlhs := ty;
currsym.st := sinteger;
currsym.vint := 0;
tx^.trhs := mklit
end
else begin
(* create file-struct wrapup *)
tx := mknode(ncall);
tx^.tcall :=
oldid(defnams[dclose]^.lid,
lidentifier);
tx^.taparm := ti
end;
nrecord:
begin
ty := nil;
tq := tq^.tflist;
while tq <> nil do
begin
if filevar(typeof(tq^.tbind)) then
begin
tz := tq^.tidl;
while tz <> nil do
begin
tx := mknode(nselect);
tx^.trecord := ti;
tx^.tfield := tz;
tx := fileinit(tx,
typeof(tq^.tbind),
opn);
tx^.tnext := ty;
ty := tx;
tz := tz^.tnext
end
end;
tq := tq^.tnext
end;
tx := mknode(nbegin);
tx^.tbegin := ty
end;
end;(* case *)
fileinit := tx
end;
begin (* initcode *)
while tp <> nil do
begin
initcode(tp^.tsubsub);
tv := tp^.tsubvar;
while tv <> nil do
begin
tq := typeof(tv^.tbind);
if filevar(tq) then
begin
ti := tv^.tidl;
while ti <> nil do
begin
tu := fileinit(ti, tq, true);
linkup(tp, tu);
tu^.tnext := tp^.tsubstmt;
tp^.tsubstmt := tu;
while tu^.tnext <> nil do
tu := tu^.tnext;
tu^.tnext := fileinit(ti, tq,
false);
linkup(tp, tu^.tnext);
ti := ti^.tnext
end
end;
tv := tv^.tnext;
end;
tp := tp^.tnext
end
end; (* initcode *)
begin (* transform *)
renamc;
renamp(top^.tsubsub, false);
extract(top);
renamf(top);
initcode(top^.tsubsub);
global(top, top, false)
end; (* transform *)
(* Emit C-code for program or module. *)
procedure emit;
const include = '# include ';
define = '# define ';
ifdef = '# ifdef ';
ifndef = '# ifndef ';
elsif = '# else';
endif = '# endif';
static = 'static ';
xtern = 'extern ';
typdef = 'typedef ';
registr = 'register ';
usigned = 'unsigned ';
indstep = 8;
var conflag,
setused,
dropset,
donearr : boolean;
doarrow,
indnt : integer;
procedure increment;
begin
indnt := indnt + indstep
end;
procedure decrement;
begin
indnt := indnt - indstep
end;
(* Write tabs/blanks to properly (?) indent C-code. *)
procedure indent;
var i : integer;
begin
i := indnt;
(* limit indent to an integral number of tabs *)
if i > 60 then
i := i div tabwidth * tabwidth;
while i >= tabwidth do
begin
write(tab1);
i := i - tabwidth
end;
while i > 0 do
begin
write(space);
i := i - 1
end;
end;
(* Determine if tp must be cast to an integer before being *)
(* used in an arithmetic expression. *)
function arithexpr(tp : treeptr) : boolean;
begin
tp := typeof(tp);
if tp^.tt = nsubrange then
if tp^.tup^.tt = nconfarr then
tp := typeof(tp^.tup^.tindtyp)
else
tp := typeof(tp^.tlo);
arithexpr := (tp = typnods[tinteger]) or
(tp = typnods[tchar]) or
(tp = typnods[treal])
end;
procedure eexpr(tp : treeptr); forward;
procedure etypedef(tp : treeptr); forward;
(* Emit code to select a record member. *)
procedure eselect(tp : treeptr);
begin
doarrow := doarrow + 1;
eexpr(tp);
doarrow := doarrow - 1;
if donearr then
donearr := false
else
write('.')
end;
(* Emit code for call to a predefined function/procedure. *)
procedure epredef(ts, tp : treeptr);
label 444, 555;
var tq,
tv, tx : treeptr;
td : predefs;
nelems : integer;
ch : char;
txtfile : boolean;
(* Determine a format-code for fprintf. *)
(* Update nelems as a sideeffect. *)
function typeletter(tp : treeptr) : char;
label 999;
var tq : treeptr;
begin
tq := tp;
if tq^.tt = nformat then
begin
if tq^.texpl^.tt = nformat then
begin
typeletter := 'f';
goto 999
end;
tq := tp^.texpl
end;
tq := typeof(tq);
if tq^.tt = nsubrange then
tq := typeof(tq^.tlo);
if tq = typnods[tstring] then
typeletter := 's'
else if tq = typnods[tinteger] then
typeletter := 'd'
else if tq = typnods[tchar] then
typeletter := 'c'
else if tq = typnods[treal] then
if tp^.tt = nformat then
typeletter := 'e'
else
typeletter := 'g'
else if tq = typnods[tboolean] then
begin
typeletter := 'b';
nelems := 6
end
else if tq^.tt = narray then
begin
typeletter := 'a';
nelems := crange(tq^.taindx)
end
else if tq^.tt = nconfarr then
begin
typeletter := 'v';
nelems := 0
end
else
fatal(etree);
999:
end; (* typeletter *)
procedure etxt(tp : treeptr);
var w : toknbuf;
c : char;
i : toknidx;
begin
case tp^.tt of
nid:
begin
tp := idup(tp);
if tp^.tt = nconst then
etxt(tp^.tbind)
else
fatal(etree)
end;
nstring:
begin
(* printf format string *)
gettokn(tp^.tsym^.lstr, w);
i := 1;
while w[i] <> chr(null) do
begin
c := w[i];
if (c = cite) or (c = bslash) then
write(bslash)
else if c = percent then
write(percent);
write(c);
i := i + 1
end
end;
nchar:
begin
(* single character in printf format *)
c := tp^.tsym^.lchar;
if (c = cite) or (c = bslash) then
write(bslash)
else if c = percent then
write(percent);
write(c)
end;
end;(* case *)
end; (* etxt *)
(* Emit format for fprintf. *)
procedure eformat(tq : treeptr);
var tx : treeptr;
i : integer;
begin
case typeletter(tq) of
'a':
begin
write(percent);
if tq^.tt = nformat then
if tq^.texpr^.tt = ninteger then
eexpr(tq^.texpr)
else
write('*');
write('.', nelems:1, 's')
end;
'b':
begin
write(percent);
if tq^.tt = nformat then
begin
if tq^.texpr^.tt = ninteger then
eexpr(tq^.texpr)
else
write('*')
end;
write('s')
end;
'c':
if tq^.tt = nchar then
etxt(tq)
else begin
write(percent);
if tq^.tt = nformat then
if tq^.texpr^.tt = ninteger then
eexpr(tq^.texpr)
else
write('*');
write('c')
end;
'd':
begin
write(percent);
if tq^.tt = nformat then
begin
if tq^.texpr^.tt = ninteger then
eexpr(tq^.texpr)
else
write('*')
end
else
write(intlen:1);
write('d')
end;
'e':
begin
write(percent, space);
tx := tq^.texpr;
if tx^.tt = ninteger then
begin
i := cvalof(tx);
write(i:1, '.');
i := i - 7;
if i < 1 then
write('1')
else
write(i:1)
end
else
write('*.*');
write('e')
end;
'f':
begin
write(percent);
tx := tq^.texpl;
if tx^.texpr^.tt = ninteger then
begin
eexpr(tx^.texpr);
write('.');
tx := tq^.texpr;
if tx^.tt = ninteger then
begin
i := cvalof(tx);
tx := tq^.texpl^.texpr;
if i > cvalof(tx) - 1 then
write('1')
else
write(i:1)
end
else
write('*');
end
else
write('*.*');
write('f')
end;
'g':
write(percent, fixlen:1, 'e');
's':
if tq^.tt = nstring then
etxt(tq)
else begin
write(percent);
if tq^.tt = nformat then
if tq^.texpr^.tt = ninteger then
eexpr(tq^.texpr)
else
write('*.*');
write('s')
end
end (* case *)
end; (* eformat *)
(* Emit parameters to fprintf except format. *)
procedure ewrite(tq : treeptr);
var tx : treeptr;
begin
case typeletter(tq) of
'a':
begin
write(', ');
tx := tq;
if tq^.tt = nformat then
begin
if tq^.texpr^.tt <> ninteger then
begin
eexpr(tq^.texpr);
write(', ')
end;
tx := tq^.texpl
end;
eexpr(tx);
write('.A')
end;
'b':
begin
write(', ');
tx := tq;
if tq^.tt = nformat then
begin
if tq^.texpr^.tt <> ninteger then
begin
eexpr(tq^.texpr);
write(', ')
end;
tx := tq^.texpl
end;
usebool := true;
write('Bools[(int)(');
eexpr(tx);
write(')]')
end;
'c':
begin
if tq^.tt = nformat then
begin
if tq^.texpr^.tt <> ninteger then
begin
write(', ');
eexpr(tq^.texpr)
end;
write(', ');
eexpr(tq^.texpl)
end
else if tq^.tt <> nchar then
begin
write(', ');
eexpr(tq)
end
end;
'd':
begin
write(', ');
tx := tq;
if tq^.tt = nformat then
begin
if tq^.texpr^.tt <> ninteger then
begin
eexpr(tq^.texpr);
write(', ')
end;
tx := tq^.texpl
end;
eexpr(tx)
end;
'e':
begin
write(', ');
tx := tq^.texpr;
if tx^.tt <> ninteger then
begin
usemax := true;
eexpr(tx);
write(', Max(');
eexpr(tx);
write(' - 7, 1), ')
end;
eexpr(tq^.texpl)
end;
'f':
begin
write(', ');
tx := tq^.texpl;
if tx^.texpr^.tt <> ninteger then
begin
eexpr(tx^.texpr);
write(', ')
end;
if (tx^.texpr^.tt <> ninteger) or
(tq^.texpr^.tt <> ninteger) then
begin
usemax := true;
write('Max((');
eexpr(tx^.texpr);
write(') - (');
eexpr(tq^.texpr);
write(') - 1, 1), ')
end;
eexpr(tq^.texpl^.texpl)
end;
'g':
begin
write(', ');
eexpr(tq)
end;
's':
begin
if tq^.tt = nformat then
begin
if tq^.texpr^.tt <> ninteger then
begin
write(', ');
eexpr(tq^.texpr);
write(', ');
eexpr(tq^.texpr)
end;
write(', ');
eexpr(tq^.texpl)
end
else if tq^.tt <> nstring then
begin
write(', ');
eexpr(tq)
end
end
end (* case *)
end; (* ewrite *)
(* Emit size of *tp for call to malloc. CPU *)
(* There is no safe way to compute the size of a *)
(* particular variant of a C-union, we assume that *)
(* the size can be computed by taking the address *)
(* of the first member and subracting the address *)
(* of the record and then adding the size of the *)
(* variant containing the record. *)
procedure enewsize(tp : treeptr);
label 555;
var tq, tx, ty : treeptr;
v : integer;
(* Emit size of union member tq. *)
procedure esubsize(tp, tq : treeptr);
label 555, 666;
var tx, ty : treeptr;
addsize : boolean;
begin
tx := tq^.tvrnt;
ty := tx^.tflist;
if ty = nil then
begin
ty := tx^.tvlist;
while ty <> nil do
begin
if ty^.tvrnt^.tflist <> nil then
begin
ty := ty^.tvrnt^.tflist;
goto 555
end;
ty := ty^.tnext
end;
555:
end;
addsize := true;
if ty = nil then
begin
(* empty variant, try using another *)
addsize := false;
ty := tx^.tup^.tup^.tvlist;
while ty <> nil do
begin
if ty^.tvrnt^.tflist <> nil then
begin
ty := ty^.tvrnt^.tflist;
goto 666
end;
ty := ty^.tnext
end;
666:
end;
if ty = nil then
begin
(* its getting too complicated,
ignore tag value *)
write('sizeof(*');
eexpr(tp);
write(')')
end
else begin
(* compute offset to first member of
the selected union variant *)
write('Unionoffs(');
eexpr(tp);
write(', ');
printid(ty^.tidl^.tsym^.lid);
if addsize then
begin
(* add the size of the selected
union variant *)
write(') + sizeof(');
eexpr(tp);
write('->');
printid(tx^.tuid)
end;
write(')')
end
end;
begin (* newsize *)
if (tp^.tnext <> nil) and unionnew then
begin
(* tnext points to a tag-value, evaluate it *)
v := cvalof(tp^.tnext);
(* find union type *)
tq := typeof(tp);
tq := typeof(tq^.tptrid);
if tq^.tt <> nrecord then
fatal(etree);
(* find corresponding variant *)
tx := tq^.tvlist;
while tx <> nil do
begin
ty := tx^.tselct;
while ty <> nil do
begin
if v = cvalof(ty) then
goto 555;
ty := ty^.tnext
end;
tx := tx^.tnext
end;
fatal(etag);
555:
(* emit size for that variant *)
esubsize(tp, tx)
end
else begin
write('sizeof(*');
eexpr(tp);
write(')')
end
end; (* newsize *)
begin (* epredef *)
td := ts^.tsubstmt^.tdef;
case td of
dabs:
begin
tq := typeof(tp^.taparm);
if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then
write('abs(') (* LIB *)
else
write('fabs('); (* LIB *)
eexpr(tp^.taparm);
write(')')
end;
dargv:
begin
write('Argvgt(');
eexpr(tp^.taparm);
write(', ');
eexpr(tp^.taparm^.tnext);
write('.A, sizeof(');
eexpr(tp^.taparm^.tnext);
writeln('.A));')
end;
dchr:
begin
tq := typeof(tp^.taparm);
if tq^.tt = nsubrange then
if tq^.tup^.tt = nconfarr then
tq := typeof(tq^.tup^.tindtyp)
else
tq := typeof(tq^.tlo);
if (tq = typnods[tinteger]) or
(tq = typnods[tchar]) then
eexpr(tp^.taparm)
else begin
write('(char)(');
eexpr(tp^.taparm);
write(')')
end
end;
ddispose:
begin
write('free('); (* LIB *)
eexpr(tp^.taparm);
writeln(');')
end;
deof:
begin
write('Eof(');
if tp^.taparm = nil then
begin
defnams[dinput]^.lused := true;
printid(defnams[dinput]^.lid)
end
else
eexpr(tp^.taparm);
write(')')
end;
deoln:
begin
write('Eoln(');
if tp^.taparm = nil then
begin
defnams[dinput]^.lused := true;
printid(defnams[dinput]^.lid)
end
else
eexpr(tp^.taparm);
write(')');
end;
dexit:
begin
write('exit('); (* OS *)
if tp^.taparm = nil then
write('0')
else
eexpr(tp^.taparm);
writeln(');');
end;
dflush:
begin
write('fflush('); (* LIB *)
if tp^.taparm = nil then
begin
defnams[doutput]^.lused := true;
printid(defnams[doutput]^.lid)
end
else
eexpr(tp^.taparm);
writeln('.fp);')
end;
dpage:
begin
(* write form-feed character *)
write('Putchr(', ffchr, ', '); (* CHAR *)
if tp^.taparm = nil then
begin
defnams[doutput]^.lused := true;
printid(defnams[doutput]^.lid)
end
else
eexpr(tp^.taparm);
writeln(');');
end;
dput,
dget:
begin
if typeof(tp^.taparm) = typnods[ttext] then
if td = dget then
write('Getx')
else
write('Putx')
else begin
write(voidcast);
if td = dget then
write('Get')
else
write('Put')
end;
write('(');
eexpr(tp^.taparm);
writeln(');')
end;
dhalt:
writeln('abort();'); (* OS *)
dnew:
begin
eexpr(tp^.taparm);
write(' = (');
etypedef(typeof(tp^.taparm));
write(')malloc((unsigned)('); (* LIB *)
enewsize(tp^.taparm);
writeln('));')
end;
dord:
begin
write('(unsigned)(');
eexpr(tp^.taparm);
write(')')
end;
dread,
dreadln:
begin
txtfile := false;
tq := tp^.taparm;
if tq <> nil then
begin
tv := typeof(tq);
if tv = typnods[ttext] then
begin
(* reading from textfile *)
txtfile := true;
tv := tq;
tq := tq^.tnext
end
else if tv^.tt = nfileof then
begin
(* reading from other file *)
txtfile := typeof(tv^.tof) =
typnods[tchar];
tv := tq;
tq := tq^.tnext
end
else begin
(* reading from std-input *)
txtfile := true;
tv := nil
end
end
else begin
tv := nil;
txtfile := true
end;
if txtfile then
begin
(* check for special case *)
if tq = nil then
goto 444;
if (tq^.tt <> nformat) and
(tq^.tnext = nil) and
(typeletter(tq) = 'c') then
begin
(* read single char *)
eexpr(tq);
write(' = ');
write('Getchr(');
if tv = nil then
printid(defnams[dinput]^.lid)
else
eexpr(tv);
write(')');
if td = dreadln then
write(',');
goto 444
end;
usescan := true;
write('Fscan(');
if tv = nil then
printid(defnams[dinput]^.lid)
else
eexpr(tv);
write('), ');
(* first pass, emit format string *)
while tq <> nil do
begin
write('Scan(', cite);
ch := typeletter(tq);
case ch of
'a':
write(percent, 's');
'c':
write(percent, 'c');
'd':
write(percent, 'ld');
'g':
write(percent, 'le')
end;(* case *)
write(cite, ', ');
case ch of
'a':
begin
eexpr(tq);
write('.A')
end;
'c':
begin
write('&');
eexpr(tq)
end;
'd':
write('&Tmplng');
'g':
write('&Tmpdbl')
end;(* case *)
write(')');
case ch of
'd':
begin
write(', ');
eexpr(tq);
write(' = Tmplng')
end;
'g':
begin
write(', ');
eexpr(tq);
write(' = Tmpdbl')
end;
'a',
'c':
(* no op *)
end;(* case *)
tq := tq^.tnext;
if tq <> nil then
begin
writeln(',');
indent;
write(tab1)
end
end;
write(', Getx(');
if tv = nil then
printid(defnams[dinput]^.lid)
else
eexpr(tv);
write(')');
if td = dreadln then
write(',');
444:
if td = dreadln then
begin
usegetl := true;
write('Getl(&');
if tv = nil then
printid(defnams[dinput]^.lid)
else
eexpr(tv);
write(')')
end
end
else begin
increment;
while tq <> nil do
begin
write(voidcast, 'Fread(');
eexpr(tq);
write(', ');
eexpr(tv);
write('.fp)');
tq := tq^.tnext;
if tq <> nil then
begin
writeln(',');
indent
end
end;
decrement
end;
writeln(';')
end;
dwrite,
dwriteln,
dmessage:
begin
txtfile := false;
tq := tp^.taparm;
if tq <> nil then
begin
tv := typeof(tq);
if tv = typnods[ttext] then
begin
(* writing to textfile *)
txtfile := true;
tv := tq;
tq := tq^.tnext
end
else if tv^.tt = nfileof then
begin
(* writing to other file *)
txtfile := typeof(tv^.tof) =
typnods[tchar];
tv := tq;
tq := tq^.tnext
end
else begin
(* writing to std-output *)
txtfile := true;
tv := nil
end
end
else begin
tv := nil;
txtfile := true
end;
if txtfile then
begin
(* check for special case *)
if tq = nil then
begin
(* writeln whithout parameters *)
if td in [dwriteln, dmessage] then
begin
write('Putchr(', nlchr, ', ');
if tv = nil then
printid(
defnams[doutput]^.lid)
else
eexpr(tv);
write(')')
end;
writeln(';');
goto 555
end
else if (tq^.tt <> nformat) and
(tq^.tnext = nil) then
if typeletter(tq) = 'c' then
begin
(* print single char *)
write('Putchr(');
eexpr(tq);
write(', ');
if tv = nil then
printid(
defnams[doutput]^.lid)
else
eexpr(tv);
write(')');
if td = dwriteln then
begin
write(',Putchr(',
nlchr, ', ');
if tv = nil then
printid(
defnams[doutput]^.lid)
else
eexpr(tv);
write(')');
end;
writeln(';');
goto 555
end;
tx := nil;
write(voidcast, 'fprintf('); (* LIB *)
if td = dmessage then
write('stderr, ')
else begin
if tv = nil then
printid(defnams[doutput]^.lid)
else
eexpr(tv);
write('.fp, ')
end;
write(cite);
tx := tq; (* remember 1:st parm *)
(* first pass, emit format string *)
while tq <> nil do
begin
eformat(tq);
tq := tq^.tnext
end;
if (td = dmessage) or (td = dwriteln) then
write('\n');
write(cite);
(* second pass, add parameters *)
tq := tx;
while tq <> nil do
begin
ewrite(tq);
tq := tq^.tnext
end;
write('), Putl(');
if tv = nil then
printid(defnams[doutput]^.lid)
else
eexpr(tv);
if td = dwrite then
write(', 0)')
else
write(', 1)')
end
else begin
increment;
tx := typeof(tv);
if tx = typnods[ttext] then
tx := typnods[tchar]
else if tx^.tt = nfileof then
tx := typeof(tx^.tof)
else
fatal(etree);
while tq <> nil do
begin
if (tq^.tt in [nid, nindex, nselect,
nderef]) and
(tx = typeof(tq)) then
begin
write(voidcast, 'Fwrite(');
eexpr(tq)
end
else begin
if tx^.tt = nsetof then
begin
usescpy := true;
write('Setncpy(');
eselect(tv);
write('buf.S, ');
eexpr(tq);
if typeof(tp^.trhs) =
typnods[tset] then
eexpr(tq)
else begin
eselect(tq);
write('S')
end;
write(', sizeof(');
eexpr(tv);
write('.buf))');
end
else begin
eexpr(tv);
write('.buf = ');
eexpr(tq)
end;
write(', Fwrite(');
eexpr(tv);
write('.buf');
end;
write(', ');
eexpr(tv);
write('.fp)');
tq := tq^.tnext;
if tq <> nil then
begin
writeln(',');
indent
end
end;
decrement
end;
writeln(';');
555:
end;
dclose:
begin
tq := typeof(tp^.taparm);
txtfile := tq = typnods[ttext];
if (not txtfile) and (tq^.tt = nfileof) then
if typeof(tq^.tof) = typnods[tchar] then
txtfile := true;
if txtfile then
write('Closex(')
else
write('Close(');
eexpr(tp^.taparm);
writeln(');');
end;
dreset,
drewrite:
begin
tq := typeof(tp^.taparm);
txtfile := tq = typnods[ttext];
if (not txtfile) and (tq^.tt = nfileof) then
if typeof(tq^.tof) = typnods[tchar] then
txtfile := true;
if txtfile then
if td = dreset then
write('Resetx(')
else
write('Rewritex(')
else
if td = dreset then
write('Reset(')
else
write('Rewrite(');
eexpr(tp^.taparm);
write(', ');
tq := tp^.taparm^.tnext;
if tq = nil then
write('NULL')
else begin
tq := typeof(tq);
if tq = typnods[tchar] then
begin
write(cite);
ch := chr(cvalof(tp^.taparm^.tnext));
if (ch = bslash) or (ch = cite) then
write(bslash);
write(ch, cite)
end
else if tq = typnods[tstring] then
eexpr(tp^.taparm^.tnext)
else if tq^.tt in [narray, nconfarr] then
begin
eexpr(tp^.taparm^.tnext);
write('.A')
end
else
fatal(etree)
end;
writeln(');')
end;
darctan:
begin
write('atan('); (* LIB *)
if typeof(tp^.taparm) <> typnods[treal] then
write(dblcast);
eexpr(tp^.taparm);
write(')')
end;
dln:
begin
write('log('); (* LIB *)
if typeof(tp^.taparm) <> typnods[treal] then
write(dblcast);
eexpr(tp^.taparm);
write(')')
end;
dexp:
begin
write('exp('); (* LIB *)
if typeof(tp^.taparm) <> typnods[treal] then
write(dblcast);
eexpr(tp^.taparm);
write(')')
end;
dcos,
dsin,
dsqrt:
begin
eexpr(tp^.tcall); (* LIB *)
write('(');
if typeof(tp^.taparm) <> typnods[treal] then
write(dblcast);
eexpr(tp^.taparm);
write(')')
end;
dtan:
begin
write('atan('); (* LIB *)
if typeof(tp^.taparm) <> typnods[treal] then
write(dblcast);
eexpr(tp^.taparm);
write(')')
end;
dsucc,
dpred:
begin
tq := typeof(tp^.taparm);
if tq^.tt = nsubrange then
if tq^.tup^.tt = nconfarr then
tq := typeof(tq^.tup^.tindtyp)
else
tq := typeof(tq^.tlo);
if (tq = typnods[tinteger]) or
(tq = typnods[tchar]) then
begin
write('((');
eexpr(tp^.taparm);
if td = dpred then
write(')-1)')
else
write(')+1)')
end
else begin
(* some sort of scalar type, casting needed *)
write('(');
tq := tq^.tup;
if tq^.tt = ntype then
begin
(* cast only if it is a named type *)
write('(');
printid(tq^.tidl^.tsym^.lid);
write(')')
end;
write('((int)(');
eexpr(tp^.taparm);
if td = dpred then
write(')-1))')
else
write(')+1))')
end
end;
dodd:
begin
write('(');
printid(defnams[dboolean]^.lid);
write(')((');
eexpr(tp^.taparm);
write(') & 1)')
end;
dsqr:
begin
tq := typeof(tp^.taparm);
if (tq = typnods[tinteger]) or (tq^.tt = nsubrange) then
begin
write('((');
eexpr(tp^.taparm);
write(') * (');
eexpr(tp^.taparm);
write('))')
end
else begin
write('pow('); (* LIB *)
if typeof(tp^.taparm) <> typnods[treal] then
write(dblcast);
eexpr(tp^.taparm);
write(', 2.0)')
end
end;
dround:
begin
write('Round(');
eexpr(tp^.taparm);
write(')')
end;
dtrunc:
begin
write('Trunc(');
eexpr(tp^.taparm);
write(')')
end;
dpack:
begin
tq := typeof(tp^.taparm);
tx := typeof(tp^.taparm^.tnext^.tnext);
write('{ ', registr, inttyp, tab1, '_j, _i = ');
if not arithexpr(tp^.taparm^.tnext) then
write('(int)');
eexpr(tp^.taparm^.tnext);
if tx^.tt = narray then
write(' - ', clower(tq^.taindx):1);
writeln(';');
indent;
write(' for (_j = 0; _j < ');
if tq^.tt = nconfarr then
begin
write('(int)(');
printid(tx^.tcindx^.thi^.tsym^.lid);
write(')')
end
else
write(crange(tx^.taindx):1);
writeln('; )');
indent;
write(tab1);
eexpr(tp^.taparm^.tnext^.tnext);
write('.A[_j++] = ');
eexpr(tp^.taparm);
writeln('.A[_i++];');
indent;
writeln('}')
end;
dunpack:
begin
tq := typeof(tp^.taparm);
tx := typeof(tp^.taparm^.tnext);
write('{ ', registr, inttyp, tab1, '_j, _i = ');
if not arithexpr(tp^.taparm^.tnext^.tnext) then
write('(int)');
eexpr(tp^.taparm^.tnext^.tnext);
if tx^.tt <> nconfarr then
write(' - ', clower(tx^.taindx):1);
writeln(';');
indent;
write(' for (_j = 0; _j < ');
if tq^.tt = nconfarr then
begin
write('(int)(');
printid(tq^.tcindx^.thi^.tsym^.lid);
write(')')
end
else
write(crange(tq^.taindx):1);
writeln('; )');
indent;
write(tab1);
eexpr(tp^.taparm^.tnext);
write('.A[_i++] = ');
eexpr(tp^.taparm);
writeln('.A[_j++];');
indent;
writeln('}')
end;
end (* case *)
end; (* epredef *)
procedure eaddr(tp : treeptr);
begin
write('&');
if not(tp^.tt in [nid, nselect, nindex, nderef]) then
error(evarpar);
eexpr(tp)
end;
(* Emit code for a subroutine call. *)
procedure ecall(tp : treeptr);
var tf, tq, tx : treeptr;
begin
(* find first formal parameter id *)
tf := idup(tp^.tcall);
case tf^.tt of
nproc,
nfunc:
tf := tf^.tsubpar;
nparproc,
nparfunc:
tf := tf^.tparparm
end;(* case *)
if tf <> nil then
begin
case tf^.tt of
nvalpar,
nvarpar:
tf := tf^.tidl;
nparproc,
nparfunc:
tf := tf^.tparid
end (* case *)
end;
(* emit called function name *)
eexpr(tp^.tcall);
write('(');
(* emit actual parameters *)
tq := tp^.taparm;
while tq <> nil do
begin
if tf^.tup^.tt in [nparfunc, nparproc] then
begin
(* single subroutine-nid converted to ncall *)
if tq^.tt = ncall then
printid(tq^.tcall^.tsym^.lid)
else
printid(tq^.tsym^.lid)
end
else begin
tx := typeof(tq);
if tx = typnods[tboolean] then
begin
tx := tq;
while tx^.tt = nuplus do
tx := tx^.texps;
if tx^.tt in [nin .. nor, nand, nnot]
then
begin
write('(');
printid(defnams[dboolean]^.lid);
write(')(');
eexpr(tq);
write(')')
end
else
eexpr(tq);
end
else if (tx = typnods[tstring]) or
(tx = typnods[tset]) then
begin
(* cast literal to proper type *)
write('*((');
etypedef(tf^.tup^.tbind);
write(' *)');
if tx = typnods[tset] then
begin
dropset := true;
eexpr(tq);
dropset := false
end
else
eexpr(tq);
write(')')
end
else if tx = typnods[tnil] then
begin
write('(');
etypedef(tf^.tup^.tbind);
write(')NIL')
end
else if tf^.tup^.tbind^.tt = nconfarr then
begin
write('(struct ');
printid(tf^.tup^.tbind^.tcuid);
write(' *)&');
eexpr(tq);
(* add upper bound of actual value *)
if tq^.tnext = nil then
write(', ',
crange(tx^.taindx):1)
end
else begin
if tf^.tup^.tt = nvarpar then
eaddr(tq)
else
eexpr(tq)
end
end;
tq := tq^.tnext;
if tq <> nil then
begin
write(', ');
(* next formal parameter *)
if tf^.tnext = nil then
begin
tf := tf^.tup^.tnext;
case tf^.tt of
nvalpar,
nvarpar:
tf := tf^.tidl;
nparproc,
nparfunc:
tf := tf^.tparid
end (* case *)
end
else
tf := tf^.tnext;
end;
end;
write(')')
end; (* ecall *)
(* Emit code for a general expression. *)
procedure eexpr;
label 999;
var tq : treeptr;
flag : boolean;
function constset(tp : treeptr) : boolean;
function constxps(tp : treeptr) : boolean;
begin
case tp^.tt of
nrange:
if constxps(tp^.texpr) then
constxps := constxps(tp^.texpl)
else
constxps := false;
nempty,
ninteger,
nchar:
constxps := true;
nid:
begin
tp := idup(tp);
constxps := (tp^.tt = nconst)
or (tp^.tt = nscalar)
end;
nin, neq, nne, nlt, nle, ngt, nge, nor,
nplus, nminus, nand, nmul, ndiv, nmod,
nquot, nnot, numinus, nuplus, nset,
nindex, nselect, nderef, ncall,
nreal, nstring, nnil:
constxps := false
end (* case *)
end;
begin
constset := true;
while tp <> nil do
if constxps(tp) then
tp := tp^.tnext
else begin
constset := false;
tp := nil
end
end;
begin (* eexpr *)
donearr := false;
if tp^.tt in [nplus, nminus, nmul, nle, nge, neq, nne] then
begin
tq := typeof(tp^.texpl);
if (tq^.tt in [nset, nsetof]) or
(tq = typnods[tset]) then
begin
(* set operations *)
case tp^.tt of
nplus:
begin
setused := true;
useunion := true;
write('Union')
end;
nminus:
begin
setused := true;
usediff := true;
write('Diff')
end;
nmul:
begin
setused := true;
useintr := true;
write('Inter')
end;
neq:
begin
useseq := true;
write('Eq')
end;
nne:
begin
usesne := true;
write('Ne')
end;
nge:
begin
usesge := true;
write('Ge')
end;
nle:
begin
usesle := true;
write('Le')
end
end;(* case *)
if tp^.tt in [nplus, nminus, nmul] then
dropset := false;
write('(');
eexpr(tp^.texpl);
if tq^.tt = nsetof then
write('.S');
write(', ');
eexpr(tp^.texpr);
tq := typeof(tp^.texpr);
if tq^.tt = nsetof then
write('.S');
write(')');
goto 999
end
end;
if tp^.tt in [neq, nne, ngt, nlt, nge, nle] then
begin
tq := typeof(tp^.texpl);
if tq^.tt = nconfarr then
fatal(ecmpconf);
if (tq^.tt in [nstring, narray]) or
(tq = typnods[tstring]) then
begin
write('Cmpstr(');
eexpr(tp^.texpl);
if tq^.tt = narray then
write('.A');
write(', ');
tq := typeof(tp^.texpr);
if tq^.tt = nconfarr then
fatal(ecmpconf);
eexpr(tp^.texpr);
if tq^.tt = narray then
write('.A');
write(')');
case tp^.tt of
neq:
write(' == ');
nne:
write(' != ');
ngt:
write(' > ');
nlt:
write(' < ');
nge:
write(' >= ');
nle:
write(' <= ');
end;(* case *)
write('0');
goto 999
end
end;
case tp^.tt of
neq, nne, nlt, nle,
ngt, nge, nor, nand, nplus, nminus,
nmul, ndiv, nmod, nquot:
begin
flag := cprio[tp^.tt] > cprio[tp^.texpl^.tt];
if (tp^.tt in [nlt, nle, ngt, nge]) and
not arithexpr(tp^.texpl) then
begin
write('(int)');
flag := true
end;
if flag then
write('(');
eexpr(tp^.texpl);
if flag then
write(')');
case tp^.tt of
neq:
write(' == ');
nne:
write(' != ');
nlt:
write(' < ');
nle:
write(' <= ');
ngt:
write(' > ');
nge:
write(' >= ');
nor:
write(' || ');
nand:
write(' && ');
nplus:
write(' + ');
nminus:
write(' - ');
nmul:
write(' * ');
ndiv:
write(' / ');
nmod:
write(' % ');
nquot:
begin
write(' / ((');
printid(defnams[dreal]^.lid);
write(')')
end
end;(* case *)
flag := cprio[tp^.tt] > cprio[tp^.texpr^.tt];
if (tp^.tt in [nlt, nle, ngt, nge]) and
not arithexpr(tp^.texpr) then
begin
write('(int)');
flag := true
end;
if flag then
write('(');
eexpr(tp^.texpr);
if flag then
write(')');
if tp^.tt = nquot then
write(')')
end;
nuplus, numinus, nnot:
begin
case tp^.tt of
numinus:
write('-');
nnot:
write('!');
nuplus:
end;(* case *)
flag := cprio[tp^.tt] >= cprio[tp^.texps^.tt];
if flag then
write('(');
eexpr(tp^.texps);
if flag then
write(')');
end;
nin:
begin
usememb := true;
write('Member((unsigned)(');
eexpr(tp^.texpl);
write('), ');
dropset := true; (* no need to save set-expr *)
eexpr(tp^.texpr);
dropset := false;
tq := typeof(tp^.texpr);
if tq^.tt = nsetof then
write('.S');
write(')')
end;
nassign:
begin
tq := typeof(tp^.trhs);
if tq = typnods[tstring] then
begin
write(voidcast, 'strncpy(');
eexpr(tp^.tlhs);
write('.A, ');
eexpr(tp^.trhs);
write(', sizeof(');
eexpr(tp^.tlhs);
write('.A))')
end
else if tq = typnods[tboolean] then
begin
eexpr(tp^.tlhs);
write(' = ');
tq := tp^.trhs;
while tq^.tt = nuplus do
tq := tq^.texps;
if tq^.tt in [nin .. nor, nand, nnot] then
begin
write('(');
printid(defnams[dboolean]^.lid);
write(')(');
eexpr(tq);
write(')')
end
else
eexpr(tq)
end
else if tq = typnods[tnil] then
begin
eexpr(tp^.tlhs);
write(' = (');
etypedef(typeof(tp^.tlhs));
write(')NIL')
end
else begin
tq := typeof(tp^.tlhs);
if tq^.tt = nsetof then
begin
usescpy := true;
write('Setncpy(');
eselect(tp^.tlhs);
write('S, ');
dropset := true;
tq := typeof(tp^.trhs);
if tq = typnods[tset] then
eexpr(tp^.trhs)
else begin
eselect(tp^.trhs);
write('S')
end;
dropset := false;
write(', sizeof(');
eselect(tp^.tlhs);
write('S))')
end
else begin
eexpr(tp^.tlhs);
write(' = ');
eexpr(tp^.trhs)
end
end
end;
ncall:
begin
tq := idup(tp^.tcall);
if (tq^.tt in [nfunc, nproc]) and
(tq^.tsubstmt <> nil) then
if tq^.tsubstmt^.tt = npredef then
epredef(tq, tp)
else
ecall(tp)
else
ecall(tp)
end;
nselect:
begin
eselect(tp^.trecord);
eexpr(tp^.tfield)
end;
nindex:
begin
eselect(tp^.tvariable);
write('A[');
tq := tp^.toffset;
if arithexpr(tq) then
eexpr(tq)
else begin
write('(int)(');
eexpr(tq);
write(')')
end;
tq := typeof(tp^.tvariable);
if tq^.tt = narray then
if clower(tq^.taindx) <> 0 then
begin
write(' - ');
tq := typeof(tq^.taindx);
if tq^.tt = nsubrange then
if arithexpr(tq^.tlo) then
eexpr(tq^.tlo)
else begin
write('(int)(');
eexpr(tq^.tlo);
write(')')
end
else
fatal(etree)
end;
write(']')
end;
nderef:
begin
tq := typeof(tp^.texps);
if (tq^.tt = nfileof) or
((tq^.tt = npredef) and (tq^.tdef = dtext)) then
begin
(* using a file-variable as pointer *)
eexpr(tp^.texps);
write('.buf')
end
else if doarrow = 0 then
begin
write('*');
eexpr(tp^.texps)
end
else begin
eexpr(tp^.texps);
write('->');
donearr := true
end
end;
nid:
begin
(* add pointer-dereference if this id is declared as a
var-parameter or as a procedure-parameter *)
tq := idup(tp);
if tq^.tt = nvarpar then
begin
if (doarrow = 0) or
(tq^.tattr = areference) then
begin
write('(*');
printid(tp^.tsym^.lid);
write(')')
end
else begin
printid(tp^.tsym^.lid);
write('->');
donearr := true
end
end
else if (tq^.tt = nconst) and conflag then
write(cvalof(tp):1)
else if tq^.tt in [nparproc, nparfunc] then
begin
write('(*');
printid(tp^.tsym^.lid);
write(')')
end
else
printid(tp^.tsym^.lid);
end;
nchar:
printchr(tp^.tsym^.lchar);
ninteger:
write(tp^.tsym^.linum:1);
nreal:
printtok(tp^.tsym^.lfloat);
nstring:
printstr(tp^.tsym^.lstr);
nset:
if constset(tp^.texps) then
begin
(* save set expression for initialization *)
write('Conset[', setcnt:1, ']');
setcnt := setcnt + 1;
tq := mknode(nset);
tq^.tnext := setlst;
setlst := tq;
tq^.texps := tp^.texps
end
else begin
increment;
flag := dropset;
(* if a set-constructor is used in an
expression involving + - * it will need to
be saved temporarily (by Saveset) but often
we can simply forget the set-value when we
have finished using it *)
if dropset then
dropset := false
else
write('Saveset(');
write('(Tmpset = Newset(), ');
tq := tp^.texps;
while tq <> nil do
begin
case tq^.tt of
nrange:
begin
usemksub := true;
write(voidcast, 'Mksubr(');
write('(unsigned)(');
eexpr(tq^.texpl);
write('), ');
write('(unsigned)(');
eexpr(tq^.texpr);
write('), Tmpset)')
end;
nin, neq, nne, nlt, nle, ngt, nge,
nor, nand, nmul, ndiv, nmod, nquot,
nplus, nminus, nnot, numinus, nuplus,
nindex, nselect, nderef, ncall,
ninteger, nchar, nid:
begin
useins := true;
write(voidcast, 'Insmem(');
write('(unsigned)(');
eexpr(tq);
write('), Tmpset)')
end
end;(* case *)
tq := tq^.tnext;
if tq <> nil then
begin
writeln(',');
indent
end
end;
write(', Tmpset)');
if not flag then
begin
write(')');
setused := true
end;
decrement
end;
nnil:
begin
tq := tp;
repeat
tq := tq^.tup
until tq^.tt in [neq, nne, ncall, nassign, npgm];
if tq^.tt in [neq, nne] then
begin
if typeof(tq^.texpl) = typnods[tnil] then
tq := typeof(tq^.texpr)
else
tq := typeof(tq^.texpl);
if tq^.tt = nptr then
begin
write('(');
etypedef(tq);
write(')')
end
end;
write('NIL')
end;
end;(* case *)
999:
end; (* eexpr *)
(* Emit constant definitions. *)
procedure econst(tp : treeptr);
var sp : symptr;
begin
while tp <> nil do
begin
sp := tp^.tidl^.tsym;
if sp^.lid^.inref > 1 then
sp^.lid := mkrename('X', sp^.lid);
if tp^.tbind^.tt = nstring then
begin
(* string constants emitted as
static local variables *)
indent;
write(static, chartyp, tab1);
printid(sp^.lid);
write('[] = ');
eexpr(tp^.tbind);
writeln(';')
end
else begin
(* all other constants emitted as
preprocessor # defines *)
write(define);
printid(sp^.lid);
write(space);
eexpr(tp^.tbind);
writeln
end;
tp := tp^.tnext
end
end; (* econst *)
(* Emit a typedef. *)
procedure etypedef;
(* Workhorse for etypedef, this procedure also *)
(* renames all fields in record-unions when *)
(* necessary. *)
procedure etdef(uid : idptr; tp : treeptr);
var i : integer;
tq : treeptr;
(* Emit definition for an integer subrange *)
(* using data from worddefs set up during *)
(* initialization. *)
procedure etrange(tp : treeptr);
label 999;
var lo, hi : integer;
i : 1 .. maxmachdefs;
begin
lo := clower(tp);
hi := cupper(tp);
(* scan CPU word definitions for a type
enclosing wanted range *)
for i := 1 to nmachdefs do
with machdefs[i] do
if (lo >= lolim) and (hi <= hilim) then
begin
(* found it, print type name *)
printtok(typstr);
goto 999
end;
fatal(erange);
999:
end;
(* Print last component of identifier. *)
procedure printsuf(ip : idptr);
var w : toknbuf;
i, j : toknidx;
begin
gettokn(ip^.istr, w);
i := 1;
j := i;
while w[i] <> chr(null) do
begin
if w[i] = '.' then
j := i;
i := i + 1
end;
if w[j] = '.' then
j := j + 1;
while w[j] <> chr(null) do
begin
write(w[j]);
j := j + 1
end
end;
begin (* etdef *)
case tp^.tt of
nid:
printid(tp^.tsym^.lid);
nptr:
begin
tq := typeof(tp^.tptrid);
if tq^.tt = nrecord then
begin
write('struct ');
printid(tq^.tuid)
end
else
printid(tp^.tptrid^.tsym^.lid);
write(' *');
end;
nscalar:
begin
write('enum { ');
increment;
tp := tp^.tscalid;
(* avoid bug in C-compiler:
enums are mixed in same namespace *)
if tp^.tsym^.lid^.inref > 1 then
tp^.tsym^.lid :=
mkrename('E', tp^.tsym^.lid);
printid(tp^.tsym^.lid);
i := 1;
while tp^.tnext <> nil do
begin
if i >= 4 then
begin
writeln(',');
indent;
i := 1
end
else begin
write(', ');
i := i + 1
end;
tp := tp^.tnext;
if tp^.tsym^.lid^.inref > 1 then
tp^.tsym^.lid :=
mkrename('E', tp^.tsym^.lid);
printid(tp^.tsym^.lid)
end;
decrement;
write(' } ')
end;
nsubrange:
begin
tq := typeof(tp^.tlo);
if tq = typnods[tinteger] then
etrange(tp)
else begin
if tq^.tup^.tt = ntype then
tq := tq^.tup^.tidl;
etdef(nil, tq)
end
end;
nfield:
begin
etdef(nil, tp^.tbind);
write(tab1);
tp := tp^.tidl;
if uid <> nil then
tp^.tsym^.lid :=
mkconc('.', uid, tp^.tsym^.lid);
printsuf(tp^.tsym^.lid);
i := 1;
while tp^.tnext <> nil do
begin
if i >= 4 then
begin
writeln(',');
indent;
write(tab1);
i := 1
end
else begin
write(', ');
i := i + 1
end;
tp := tp^.tnext;
if uid <> nil then
tp^.tsym^.lid :=
mkconc('.', uid, tp^.tsym^.lid);
printsuf(tp^.tsym^.lid);
end;
writeln(';');
end;
nrecord:
begin
write('struct ');
if tp^.tuid = nil then
tp^.tuid := uid
else if uid = nil then
printid(tp^.tuid);
writeln(' {');
increment;
if (tp^.tflist = nil) and
(tp^.tvlist = nil) then
begin
(* C doesn't allow empty structures *)
indent;
writeln(inttyp, tab1, 'dummy;')
end;
tq := tp^.tflist;
while tq <> nil do
begin
indent;
etdef(uid, tq);
tq := tq^.tnext
end;
if tp^.tvlist <> nil then
begin
indent;
writeln('union {');
increment;
tq := tp^.tvlist;
while tq <> nil do
begin
if (tq^.tvrnt^.tflist <> nil) or
(tq^.tvrnt^.tvlist <> nil) then
begin
indent;
if uid = nil then
etdef(mkvrnt,
tq^.tvrnt)
else
etdef(mkconc('.',
uid, mkvrnt),
tq^.tvrnt);
writeln(';')
end;
tq := tq^.tnext
end;
decrement;
indent;
writeln('} U;');
end;
decrement;
indent;
if tp^.tup^.tt = nvariant then
begin
write('} ');
printsuf(tp^.tuid)
end
else
write('}');
end;
nconfarr:
begin
write('struct ');
printid(tp^.tcuid);
write(' { ');
etdef(nil, tp^.tcelem);
write(tab1, 'A[]; }')
end;
narray:
begin
write('struct { ');
etdef(nil, tp^.taelem);
write(tab1, 'A[');
tq := typeof(tp^.taindx);
if tq^.tt = nsubrange then
begin
if arithexpr(tq^.thi) then
begin
eexpr(tq^.thi);
if cvalof(tq^.tlo) <> 0 then
begin
write(' - ');
eexpr(tq^.tlo)
end
end
else begin
write('(int)(');
eexpr(tq^.thi);
if cvalof(tq^.tlo) <> 0 then
begin
write(') - (int)(');
eexpr(tq^.tlo)
end;
write(')')
end;
write(' + 1')
end
else
write(crange(tp^.taindx):1);
write(']; }')
end;
nfileof:
begin
writeln('struct {');
indent;
writeln(tab1, 'FILE', tab1, '*fp;');
indent;
writeln(tab1, filebits, tab1, 'eoln:1,');
indent;
writeln(tab3, 'eof:1,');
indent;
writeln(tab3, 'out:1,');
indent;
writeln(tab3, 'init:1,');
indent;
writeln(tab3, ':', filefill:1, ';');
indent;
write(tab1);
etdef(nil, tp^.tof);
writeln(tab1, 'buf;');
indent;
write('} ')
end;
nsetof:
write('struct { ', setwtyp, tab1, 'S[',
csetsize(tp):1, ']; }');
npredef:
begin
case tp^.tobtyp of
tboolean:
printid(defnams[dboolean]^.lid);
tchar:
write(chartyp);
tinteger:
printid(defnams[dinteger]^.lid);
treal:
printid(defnams[dreal]^.lid);
tstring:
write(chartyp, ' *');
ttext:
write('text');
tnil,
tset,
terror:
fatal(etree);
tnone:
write(voidtyp);
end (* case *)
end;
nempty:
write(voidtyp);
end;(* case *)
end; (* etdef *)
begin
etdef(nil, tp)
end; (* etypedef *)
(* Emit code for type declarations. *)
procedure etype(tp : treeptr);
var sp : symptr;
begin
while tp <> nil do
begin
(* if identifier used more than once we rename the type
to avoid typedef'ing an identifier twice *)
sp := tp^.tidl^.tsym;
if sp^.lid^.inref > 1 then
sp^.lid := mkrename('Y', sp^.lid);
indent;
write(typdef);
etypedef(tp^.tbind);
write(tab1);
printid(sp^.lid);
writeln(';');
tp := tp^.tnext
end
end;
(* Emit code for variable declarations. *)
procedure evar(tp : treeptr);
label 555;
var tq : treeptr;
i : integer;
begin
while tp <> nil do
begin
indent;
case tp^.tt of
nvar,
nvalpar,
nvarpar:
begin
if tp^.tattr = aregister then
write(registr);
etypedef(tp^.tbind)
end;
nparproc,
nparfunc:
begin
if tp^.tt = nparproc then
write(voidtyp)
else
etypedef(tp^.tpartyp);
tq := tp^.tparid;
write(tab1, '(*');
printid(tq^.tsym^.lid);
write(')()');
goto 555
end
end;(* case *)
write(tab1);
tq := tp^.tidl;
i := 1;
repeat
if tp^.tt = nvarpar then
write('*');
printid(tq^.tsym^.lid);
tq := tq^.tnext;
if tq <> nil then
begin
if i >= 6 then
begin
i := 1;
writeln(',');
indent;
write(tab1)
end
else begin
i := i + 1;
write(', ')
end
